Take Home Exercise 2

VAST Challenge 2025 Mini-Challenge 1
Published

May 13, 2025

Modified

June 3, 2025

1 Overview

For this take-home exercise, we will be working on Mini-Challenge 1 from the VAST Challenge 2025. The objective of this exercise is to design visual analytics methods to track the emergence of a rising artist and forecast the next potential breakout star.

We will address the questions from the mini-challenge specifically Question 3:

1.1 The Profile of Sailor Shift’s Career :

  • Who has Sailor Shift been most influenced by over time?
  • Who has she collaborated with and directly or indirectly influenced?
  • How has she influenced collaborators within the broader Oceanus Folk community?

1.2 The Influence of Oceantus Folk to the Music World :

  • Was this influence intermittent or did it show a gradual rise?
  • What genres and top artists have been most influenced by Oceanus Folk?
  • On the conveerse, how has Oceantus Folk changed the rise of Sailor Shift? From which genre does it draw most of its contemporary inspiration?

1.3 Profile of What it Means to be a Rising Star in the Music Industry

  • Visualize the careers of 3 Artist
  • Compare and Contrast their rise in Popularity and Influence
  • Using this characterization, gives 3 Predictions of the next Oceanus Folk stars with be over the next 5 Years

2 The Data

We will use the dataset provided in the VAST Challenge 2025 Mini-Challenge 1.

Attribute Value
File Name MC1_graph.json
Graph Type Directed Multigraph
Number of Nodes 17,412
Number of Edges 37,857
Connected Components 18
Node_Type
Person
Song
RecordLabel
Album
MusicalGroup
Edge_Type Description
PerformerOf Source (Person or Group) performed the destination (Song or Album)
ComposerOf Source (Person) composed the destination (Song or Album)
ProducerOf Source (Person or Label) produced the destination’s work (Song, Album, Person, or Group)
LyricistOf Source (Person) wrote lyrics for the destination (Song or Album)
RecordedBy Destination (Label) recorded the source (Song or Album)
DistributedBy Destination (Label) distributed the source (Song or Album)
InStyleOf Source (Song/Album) is in the style of the destination (Song, Album, Person, or Group)
InterpolatesFrom Source (Song/Album) interpolates melody from the destination (Song or Album)
CoverOf Source (Song/Album) is a cover of the destination (Song or Album)
LyricalReferenceTo Source (Song/Album) makes lyrical reference to the destination (Song or Album)
DirectlySamples Source (Song/Album) directly samples audio from the destination (Song or Album)
MemberOf Source (Person) is a member of the destination (MusicalGroup)

3 Setting Up

3.1 Loading Packages

pacman::p_load(tidyverse, jsonlite,
               tidygraph, ggraph, igraph, plotly, visNetwork,ggtext, ggiraph,patchwork, kableExtra, showtext)
Library Description
pacman A package management tool that simplifies the process of installing, loading, and managing R packages with a single function. Ideal for scripts requiring multiple libraries.
tidyverse A cohesive collection of R packages for data science, including ggplot2, dplyr, tidyr, readr, and more—providing consistent grammar for data wrangling and visualization.
jsonlite A fast and flexible JSON parser/serializer, useful for importing and exporting structured data such as API responses or configuration files.
tidygraph A tidyverse-friendly package for network data manipulation and analysis, built on top of igraph. Enables graph operations using dplyr-like syntax.
ggraph An extension of ggplot2 for visualizing graph/network data using layered grammar of graphics principles. Works seamlessly with tidygraph.
igraph A powerful low-level package for network analysis and visualization, supporting complex graph structures, centrality metrics, and community detection.
plotly Enables creation of interactive plots from ggplot2 or native plotly syntax. Useful for dashboards, exploratory data analysis, and web-based visualizations.
visNetwork Creates rich, interactive network visualizations using vis.js. Highly customizable and ideal for interactive dashboards and exploratory analysis.
ggtext Enhances ggplot2 by allowing Markdown/HTML formatting in axis labels, legends, titles, and more—perfect for expressive visual storytelling.
ggiraph Adds interactivity (tooltips, hover effects, hyperlinks) to ggplot2 graphics. Useful for embedding interactive plots in Shiny apps or HTML reports.
patchwork Simplifies the combination of multiple ggplot2 plots into a single layout using intuitive arithmetic-like syntax. Great for dashboards or multi-panel displays.
kableExtra Extends knitr::kable() to create professional-looking tables in HTML, LaTeX, or Word with styling, column grouping, footnotes, and more.
showtext Makes it easy to use custom fonts in R plots, including Chinese, Japanese, and Korean fonts—ideal for multilingual data visualization.

3.2 Loading Data

data <- fromJSON("data/MC1_graph.json")
glimpse(data)
List of 5
 $ directed  : logi TRUE
 $ multigraph: logi TRUE
 $ graph     :List of 2
  ..$ node_default: Named list()
  ..$ edge_default: Named list()
 $ nodes     :'data.frame': 17412 obs. of  10 variables:
  ..$ Node Type     : chr [1:17412] "Song" "Person" "Person" "Person" ...
  ..$ name          : chr [1:17412] "Breaking These Chains" "Carlos Duffy" "Min Qin" "Xiuying Xie" ...
  ..$ single        : logi [1:17412] TRUE NA NA NA NA FALSE ...
  ..$ release_date  : chr [1:17412] "2017" NA NA NA ...
  ..$ genre         : chr [1:17412] "Oceanus Folk" NA NA NA ...
  ..$ notable       : logi [1:17412] TRUE NA NA NA NA TRUE ...
  ..$ id            : int [1:17412] 0 1 2 3 4 5 6 7 8 9 ...
  ..$ written_date  : chr [1:17412] NA NA NA NA ...
  ..$ stage_name    : chr [1:17412] NA NA NA NA ...
  ..$ notoriety_date: chr [1:17412] NA NA NA NA ...
 $ links     :'data.frame': 37857 obs. of  4 variables:
  ..$ Edge Type: chr [1:37857] "InterpolatesFrom" "RecordedBy" "PerformerOf" "ComposerOf" ...
  ..$ source   : int [1:37857] 0 0 1 1 2 2 3 5 5 5 ...
  ..$ target   : int [1:37857] 1841 4 0 16180 0 16180 0 5088 14332 11677 ...
  ..$ key      : int [1:37857] 0 0 0 0 0 0 0 0 0 0 ...

3.3 Custom Style

cl <- list(
  bg = "#FEFCF3",
  t_shirt = "#7B3F00",
  sweater = "#D7A18F",
  jeans = "#D9C6B0",
  title = "#2F3A3F",
  background = "#F8F1E5",
  text = "#B1A293",
  
  #Nodes
  Person = "#D5D1E9",       
  MusicalGroup = "#D0E4EE",  
  RecordLabel = "#F3F5A9",   
  Song = "#F5CF9F",          
  Album = "#F28B82",
  
  #Edges
  PerformerOf         = "#e6194b",  
  ComposerOf          = "#f58231",  
  ProducerOf          = "#ffe119",  
  LyricistOf          = "#3cb44b",  
  RecordedBy          = "#42d4f4",  
  DistributedBy       = "#4363d8",  
  InStyleOf           = "#911eb4",  
  InterpolatesFrom    = "#f032e6",  
  CoverOf             = "#fabebe",  
  LyricalReferenceTo  = "#ffd8b1",  
  DirectlySamples     = "#fffac8", 
  MemberOf            = "#4A7365"   
)
font_add_google("Montserrat", "montserrat")
showtext_auto()
theme <- list(
  font = 'montserrat',
  size=14,
  background = element_rect(fill = cl$bg,color = NA),
  title = element_text(
      size = 16,
      face = "bold",
      color = "black"),
  fill = cl$text,
  panel = element_rect(fill = cl$bg, color = NA),
  grid = element_line(color = "#E6DCD0"),
  
  #Text 
  caption = "Hover on the nodes to see more details.",
  
  #Node
  node_size = 7.5,
  arrow_margin = 3.2,
  arrow_style = arrow(type = "closed", length = unit(2, "pt")),
  base_edge_thickness = 0.2,
  
  tooltip = "background-color: #E6DCD0;
  color: #2F3A3F;
  border: 1px solid #e0d7ec;
  border-radius: 6px;
  padding: 6px;
  font-size: 12px;
  box-shadow: 1px 1px 4px rgba(0,0,0,0.1);
  "
)

4 Data Preparation

4.1 Extracting

edges <- as_tibble(data$links)
edge
# A tibble: 12 × 2
   Edge_Type          Description                                               
   <chr>              <chr>                                                     
 1 PerformerOf        Source (Person or Group) performed the destination (Song …
 2 ComposerOf         Source (Person) composed the destination (Song or Album)  
 3 ProducerOf         Source (Person or Label) produced the destination's work …
 4 LyricistOf         Source (Person) wrote lyrics for the destination (Song or…
 5 RecordedBy         Destination (Label) recorded the source (Song or Album)   
 6 DistributedBy      Destination (Label) distributed the source (Song or Album)
 7 InStyleOf          Source (Song/Album) is in the style of the destination (S…
 8 InterpolatesFrom   Source (Song/Album) interpolates melody from the destinat…
 9 CoverOf            Source (Song/Album) is a cover of the destination (Song o…
10 LyricalReferenceTo Source (Song/Album) makes lyrical reference to the destin…
11 DirectlySamples    Source (Song/Album) directly samples audio from the desti…
12 MemberOf           Source (Person) is a member of the destination (MusicalGr…
nodes <- as_tibble(data$nodes)
nodes
# A tibble: 17,412 × 10
   `Node Type` name         single release_date genre notable    id written_date
   <chr>       <chr>        <lgl>  <chr>        <chr> <lgl>   <int> <chr>       
 1 Song        Breaking Th… TRUE   2017         Ocea… TRUE        0 <NA>        
 2 Person      Carlos Duffy NA     <NA>         <NA>  NA          1 <NA>        
 3 Person      Min Qin      NA     <NA>         <NA>  NA          2 <NA>        
 4 Person      Xiuying Xie  NA     <NA>         <NA>  NA          3 <NA>        
 5 RecordLabel Nautical Mi… NA     <NA>         <NA>  NA          4 <NA>        
 6 Song        Unshackled … FALSE  2026         Lo-F… TRUE        5 <NA>        
 7 Person      Luke Payne   NA     <NA>         <NA>  NA          6 <NA>        
 8 Person      Xiulan Zeng  NA     <NA>         <NA>  NA          7 <NA>        
 9 Person      David Frank… NA     <NA>         <NA>  NA          8 <NA>        
10 RecordLabel Colline-Cas… NA     <NA>         <NA>  NA          9 <NA>        
# ℹ 17,402 more rows
# ℹ 2 more variables: stage_name <chr>, notoriety_date <chr>
colnames(nodes)[colnames(nodes) == "Node Type"] <- "type"
colnames(edges)[colnames(edges) == "Edge Type"] <- "relation"

4.2 Check Missing Values

colSums(is.na(edges))
relation   source   target      key 
       0        0        0        0 
colSums(is.na(nodes))
          type           name         single   release_date          genre 
             0              0          13797          12801          12801 
       notable             id   written_date     stage_name notoriety_date 
         12801              0          15957          16889          16763

4.3 Check for Duplicates

edges[duplicated(edges),]
# A tibble: 0 × 4
# ℹ 4 variables: relation <chr>, source <int>, target <int>, key <int>
nodes[duplicated(nodes),]
# A tibble: 0 × 10
# ℹ 10 variables: type <chr>, name <chr>, single <lgl>, release_date <chr>,
#   genre <chr>, notable <lgl>, id <int>, written_date <chr>, stage_name <chr>,
#   notoriety_date <chr>

5 Knowledge Graph

5.1 Mapping from node id to row index

id_map <- tibble(id = nodes$id,
                 index = seq_len(
                   nrow(nodes)))

5.2 Map source and target IDs to row indices

edges <- edges %>%
  left_join(id_map, by = c("source" = "id")) %>%
  rename(from = index) %>%
  left_join(id_map, by = c("target" = "id")) %>%
  rename(to = index)

5.3 Filtering out unmatched edges

edges <- edges %>%
  filter(!is.na(from), !is.na(to))

5.4 Plotting the Whole Graph

graph <- tbl_graph(nodes = nodes, edges = edges, directed = data$directed)

graph <- graph %>%
  activate(nodes) %>%
  mutate(`Node Type` = factor(type, levels = names(cl)))

6 Exploratory Data Analysis

Code 
ggplot(data = edges,
       aes(y = relation)) +
  geom_bar(fill = theme$fill) +
  labs(title="Distribution of Edge Type") +
  theme_classic() +
  theme(plot.background = theme$background,
        panel.background = theme$panel,
        panel.grid.major = theme$grid,
        text = element_text(family = theme$font,
                            size = theme$size),
        plot.title = theme$title)

Code 
ggplot(data = nodes,
       aes(y = type)) +
  geom_bar(fill = theme$fill) +
  labs(title="Distribution of Node Type") +
  theme_classic() +
  theme(plot.background = theme$background,
        panel.background = theme$panel,
        panel.grid.major = theme$grid,
        text = element_text(family = theme$font,
                            size = theme$size),
        plot.title = theme$title)

6.1 Understanding the Most Connected Nodes

Code 
graph %>%
  activate(nodes) %>%
  mutate(degree = centrality_degree()) %>%
  as_tibble() %>%
  arrange(desc(degree)) %>%
  slice_head(n = 10) %>%
  ggplot(aes(x = reorder(name, degree), 
             y = degree, 
             fill = `Node Type`)) +
  geom_col() +
  geom_text(aes(label = degree), 
            hjust = -0.2, 
            size = 4, 
            family = theme$font) +
  coord_flip() +
  labs(title = "Top 10 Most Connected Nodes", x = "Name", y = "Degree") + 
  scale_fill_manual(values = cl
  ) +
  theme_classic() +
  theme(
    plot.background = theme$background,
    panel.background = theme$panel,
    panel.grid.major = theme$grid,
    text = element_text(family = theme$font, size = theme$size),
    plot.title = theme$title
  )

  • Degree is a measure in network analysis that represents the number of direct connections a node has to other nodes.

  • Here I plot Top 10 Most Connected Nodes Plot to quickly see the key collaborators and influencers based on their direct connections within the community.

6.2 Top Genres

Code 
nodes %>%
  filter(!is.na(genre)) %>%
  count(genre, sort = TRUE) %>%
  slice_max(n, n = 10) %>%
  ggplot(aes(x = reorder(genre, n), y = n, fill = n)) +
  geom_col() +
  scale_fill_gradient(low = cl$jeans, high = cl$text) +
  coord_flip() +
  labs(title = "Top 10 Genres", x = "Genre", y = "Count") +
  theme_classic() +
  theme(plot.background = theme$background,
        panel.background = theme$panel,
        panel.grid.major = theme$grid,
        text = element_text(family = theme$font,
                            size = theme$size),
        plot.title = theme$title)

  • Oceanus Folk is among the top genres which align with the narrative that Sailor Shift’s rise helped the Oceanus Folk genre into the mainstream music genres.

  • Dream Pop, Indie Folk, and Synthwave are the most represented genres in the dataset.

7 Plotting Sub-Graphs

In this part, I will create several subnetworks to explore different perspectives within the dataset.

Code 
plot<- function(graph, center_name, title, size_1, size_2, show_arrows = TRUE, layout = "fr") {
  
  set.seed(123)

  V(graph)$type <- trimws(as.character(V(graph)$type))
  E(graph)$relation <- trimws(as.character(E(graph)$relation))
  V(graph)$name <- gsub("'", "`", V(graph)$name)
  V(graph)$is_center <- V(graph)$name == center_name
  V(graph)$tooltip <- paste0(
  "Name: ", V(graph)$name, "\n",
  "Type: ", V(graph)$type)
  V(graph)$node_size <- degree(graph)
  V(graph)$node_size <- scales::rescale(degree(graph), to = c(size_1, size_2))

  node_colors <- cl[names(cl) %in% unique(V(graph)$type)]
  edge_colors <- unlist(cl[names(cl) %in% unique(E(graph)$relation)])
  
  edge_layer <- if (show_arrows) {
  geom_edge_link(
    aes(edge_colour = relation),
    arrow = arrow(length = unit(1.5, "mm"), type = "closed"),
    end_cap = circle(0.5, "mm"),
    start_cap = circle(0.5, "mm"),
    width = 0.3,
    alpha = 0.7
  )
} else {
  geom_edge_link(
    aes(edge_colour = relation),
    end_cap = circle(0.5, "mm"),
    start_cap = circle(0.5, "mm"),
    width = 0.3,
    alpha = 0.7
  )
}

  g<-ggraph(graph, layout = layout) +
    edge_layer +
    geom_edge_link(
  aes(color = relation),
  arrow = if (show_arrows) arrow(length = unit(1.5, "mm"), type = "closed") else NULL,
  end_cap = circle(0.5, "mm"),
  start_cap = circle(0.5, "mm"),
  width = 0.3,
  alpha = 0.7)+
    geom_point_interactive(aes(
      x = x, y = y,
      fill = as.character(type),
      tooltip = tooltip,
      data_id = name,
      size = node_size,
      stroke = ifelse(is_center, 1, 0.15)
    ),
    shape = 21
  ) +
    scale_size_identity()+
    geom_node_text(
  aes(label = ifelse(is_center, name, "")),
  nudge_y = 0.1, 
  nudge_x = -0.2, 
  repel = TRUE,
  size = 3,
  color = "black"
  )+
    theme_minimal() +
    labs(title = title,
         caption = "Hover to view details") +
    scale_fill_manual(values = node_colors, name = "Node Type") +
    scale_edge_colour_manual(values = edge_colors, name = "Edge Type") +
    theme_minimal() +
    theme(
      panel.border = element_rect(color = "black", fill = NA, size = 0.5),
      axis.title = element_blank(),
      axis.text = element_blank(),
      axis.ticks = element_blank(),
      panel.grid = element_blank(),
      plot.background = element_rect(fill = "#FEFCF3", color = NA),
      plot.title = element_text(color = cl$title, size = 14, face = "bold"),
      plot.caption = element_text(hjust = 0, size = 8,face = "bold", margin = margin(t = 10),color = cl$title),
      legend.text = element_text(size = 9),      
      legend.title = element_text(size = 10),     
      legend.key.size = unit(0.5, "lines"),       
      legend.spacing.y = unit(2, "pt")            
    )
  girafe(ggobj = g,
         options = list(opts_tooltip(css = theme$tooltip)))
}

7.1 Functions

Ego

Code 
ego_subgraph <- function(graph, center_name) {
  graph %>%
    activate(nodes) %>%
    mutate(is_target = name == center_name) %>%
    convert(to_subgraph, node_is_adjacent(which(is_target)) | is_target)
}

Genre

Code 
get_oceanusfolk_subgraph <- function(graph, genre_name = "Oceanus Folk", relation_type = "PerformerOf") {
  oceanus_songs <- V(graph)[type == "Song" & genre == genre_name]
  performer_edges <- E(graph)[relation == relation_type & .inc(oceanus_songs)]
  connected_nodes <- unique(as.vector(ends(graph, performer_edges)))
  temp_subgraph <- induced_subgraph(graph, V(graph)[name %in% connected_nodes])
  subgraph.edges(temp_subgraph, E(temp_subgraph)[relation == relation_type])
}

7.2 Sailor Shift Ego Network

Code 
sailor_ego <- ego_subgraph(graph, "Sailor Shift")
plot(sailor_ego,"Sailor Shift","Ego Network of Sailor Shift",3,5)

7.3 Oceanus Folk Sub Graph

Code 
oceanusfolk_subgraph <- get_oceanusfolk_subgraph(graph)
plot(oceanusfolk_subgraph, center_name = "", title = "Oceanus Folk Songs",1,2,FALSE)

8 Mini Challenge

8.1 Question 3 : Visualize the careers of three artists

To ensure genre-relevant comparisons, I limited my analysis to artists connected to the Oceanus Folk community through performer or stylistic influence links.

To have a data driven definition of a rising star within Oceanus Folk music industry, I begin by examining the career of Sailor Shift. Her rise in popularity provides a benchmark for identifying the key traits and network patterns that characterize emerging breakout artists in this genre.

To identify rising stars in the Oceanus Folk genre, I propose the following set of metrics based on network structure and artist activity:

8.1.1 Defining Key Metrics

Rising Star Profile Metrics
Trait Measured By
Creative Activity Songs & Album released over time
Creative Contribution ComposerOf, LyricistOf, ProducerOf edges
Collaboration Any other person who is connected to the same song(s) as the artist via a creative roles
Public Recognition Number of notable releases over time

8.1.2 Functions

Plot

Code 
plot <- function(graph, center_name, title, size_1, size_2, show_arrows = TRUE, layout = "fr") {
  set.seed(123)

  V(graph)$type       <- trimws(as.character(V(graph)$type))
  V(graph)$name       <- gsub("'", "`", V(graph)$name)
  V(graph)$is_center  <- V(graph)$name == center_name
  V(graph)$tooltip    <- paste0("Name: ", V(graph)$name, "\nYear: ", V(graph)$release_date)
  V(graph)$node_size  <- scales::rescale(degree(graph), to = c(size_1, size_2))

  E(graph)$relation   <- trimws(as.character(E(graph)$relation))

  node_colors <- cl[names(cl) %in% unique(V(graph)$type)]
  edge_colors <- unlist(cl[names(cl) %in% unique(E(graph)$relation)])

  g <- ggraph(graph, layout = layout) +
    geom_edge_link(
      aes(edge_colour = relation),
      arrow     = if (show_arrows) arrow(length = unit(3, "mm"), type = "closed") else NULL,
      end_cap   = circle(0.5, "mm"),
      start_cap = circle(0.5, "mm"),
      width     = 0.3,
      alpha     = 0.7
    ) +
    scale_edge_colour_manual(values = edge_colors, name = "Edge Type") +
    
    geom_point_interactive(
      aes(
        x = x, y = y,
        fill     = as.character(type),
        tooltip  = tooltip,
        data_id  = name,
        size     = node_size,
        stroke   = ifelse(is_center, 1, 0.15)
      ),
      shape = 21
    ) +
    scale_size_identity() +

    geom_node_text(
      aes(label = ifelse(is_center, name, "")),
      nudge_y = 0.5, 
      nudge_x = 0.2,
      repel   = TRUE,
      size    = 4,
      color   = "black"
    ) +

    labs(
      title   = title,
      caption = "Hover to view node's details"
    ) +
    scale_fill_manual(values = node_colors, name = "Node Type") +
    theme_minimal() +
    theme(
      panel.border      = element_rect(color = "black", fill = NA, size = 0.5),
      axis.title        = element_blank(),
      axis.text         = element_blank(),
      axis.ticks        = element_blank(),
      panel.grid        = element_blank(),
      plot.background   = element_rect(fill = "#FEFCF3", color = NA),
      plot.title        = element_text(color = cl$title, size = 14, face = "bold"),
      plot.caption      = element_text(hjust = 0, size = 8, face = "bold", 
                                       margin = margin(t = 10), color = cl$title),
      legend.text       = element_text(size = 9),
      legend.title      = element_text(size = 10),
      legend.key.size   = unit(0.5, "lines"),
      legend.spacing.y  = unit(2, "pt")
    )

  girafe(
    ggobj   = g,
    options = list(opts_tooltip(css = theme$tooltip))
  )
}

Clean Duplicates

Code 
clean_duplicate_artist <- function(graph, artist_name) {

  igraph <- as.igraph(graph)

  node_ids <- which(V(igraph)$name == artist_name)

  if (length(node_ids) > 1) {
    main_node <- node_ids[1]
    dup_nodes <- node_ids[-1]

    for (dup in dup_nodes) {
      inc_edges <- incident(igraph, dup, mode = "all")

      for (e in inc_edges) {
        ends_ids <- ends(igraph, e, names = FALSE)

        from_id <- ends_ids[1]
        to_id   <- ends_ids[2]

        if (from_id == dup) from_id <- main_node
        if (to_id == dup) to_id <- main_node

        if (from_id != to_id) {
          edge_attrs <- edge.attributes(igraph, e)

          igraph <- add_edges(igraph, c(from_id, to_id))
          new_edge_id <- ecount(igraph)

          for (attr_name in names(edge_attrs)) {
            edge_attr(igraph, attr_name, index = new_edge_id) <- edge_attrs[[attr_name]]
          }
        }
      }
    }

    igraph <- delete_vertices(igraph, dup_nodes)
  }

  return(as_tbl_graph(igraph))
}

Creative Activity

Code 
artist_creativity <- function(graph, artist_name) {

  artist_index <- graph %>%
    activate(nodes) %>%
    mutate(index = row_number()) %>%
    filter(name == artist_name) %>%
    pull(index)

  member_of_groups <- graph %>%
    activate(edges) %>%
    filter(from == artist_index, relation == "MemberOf") %>%
    pull(to)

  group_names <- character()
  group_indices <- integer()

  if (length(member_of_groups) > 0) {
    group_names <- graph %>%
      activate(nodes) %>%
      mutate(index = row_number()) %>%
      filter(index %in% member_of_groups) %>%
      pull(name)

    group_indices <- graph %>%
      activate(nodes) %>%
      mutate(index = row_number()) %>%
      filter(name %in% group_names) %>%
      pull(index)
  }

  performer_ids <- c(artist_index, group_indices)

  performed_ids <- graph %>%
    activate(edges) %>%
    filter(relation == "PerformerOf", from %in% performer_ids) %>%
    pull(to)

  performed_works <- graph %>%
    activate(nodes) %>%
    mutate(index = row_number()) %>%
    filter(index %in% performed_ids,
           (type == "Song" & single == TRUE & !is.na(single)) | type == "Album") %>%
    select(name, release_date, type, index) %>%
    arrange(release_date) %>%
    as_tibble()

  subgraph_indices <- unique(c(artist_index, group_indices, performed_works$index))

  subgraph <- induced_subgraph(graph, vids = subgraph_indices) %>%
    as_tbl_graph() %>%
    activate(edges) %>%
    filter(relation %in% c("PerformerOf", "MemberOf")) %>%
    activate(nodes) %>%
    mutate(label = case_when(
      type == "Song" ~ paste0(name, " (", release_date, ")"),
      type == "Album" ~ paste0("[Album] ", name, " (", release_date, ")"),
      TRUE ~ name
    ))

  return(list(
    graph = subgraph,
    works = performed_works %>% select(name, type, release_date),
    group = group_names
  ))
}
Code 
release_timeline <- function(song_years, artist_name = "Artist") {

  release_counts <- song_years %>%
    filter(type %in% c("Song", "Album")) %>%
    mutate(release_year = as.integer(release_date)) %>%
    count(release_year)

  ggplot(release_counts, aes(x = release_year, y = n)) +
    geom_line(color = cl$jeans, linewidth = 1.2) +
    geom_point(color = cl$t_shirt, size = 2) +
    labs(
      title = paste0(artist_name, "'s Songs or Albums Release Timeline"),
      x = "Year",
      y = "Number of Releases"
    ) +
    scale_x_continuous(breaks = seq(min(release_counts$release_year),
                                    max(release_counts$release_year), by = 1)) +
    scale_y_continuous(breaks = seq(0, max(release_counts$n), by = 1)) +
    theme_classic() +
    theme(
      plot.background = theme$background,
      panel.background = theme$panel,
      panel.grid.major = theme$grid,
      text = element_text(family = theme$font, size = theme$size),
      plot.title = theme$title,
      axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
    )
}

Creative Contribution

Code 
contribution_network <- function(graph, artist_name) {

  artist_id <- graph %>%
    activate(nodes) %>%
    mutate(index = row_number()) %>%
    filter(name == artist_name) %>%
    pull(index)

  creative_edges <- graph %>%
    activate(edges) %>%
    filter(from == artist_id, relation %in% c("ComposerOf", "LyricistOf", "ProducerOf")) %>%
    as_tibble()

  node_info <- graph %>%
  activate(nodes) %>%
  mutate(index = row_number()) %>%
  as_tibble()  

  creative_edges <- creative_edges %>%
    left_join(node_info %>% select(index, name, release_date, type) %>%
              mutate(release_year = as.integer(release_date)),
            by = c("to" = "index"))

  song_ids <- creative_edges$to
  subgraph_indices <- unique(c(artist_id, song_ids))

  subgraph <- induced_subgraph(graph, vids = subgraph_indices) %>%
    as_tbl_graph() %>%
    activate(edges) %>%
    filter(relation %in% c("ComposerOf", "LyricistOf", "ProducerOf")) %>%
    activate(nodes) %>%
    mutate(
      label = paste0(name, " (", release_date, ")")
    )

  song_data <- creative_edges %>%
    select(name, relation, release_date, release_year) %>%
    arrange(release_date)

  return(list(graph = subgraph, song_data = song_data))
}

Artist Collaborators

Code 
artist_collab_network <- function(graph, artist_name) {
  collab_roles <- c("PerformerOf", "ComposerOf", "LyricistOf", "ProducerOf")
  
  artist_index <- graph %>%
    activate(nodes) %>%
    mutate(index = row_number()) %>%
    filter(name == artist_name) %>%
    pull(index)
  
  artist_songs <- graph %>%
    activate(edges) %>%
    filter(from == artist_index, relation %in% collab_roles) %>%
    pull(to)
  
  collab_edges <- graph %>%
    activate(edges) %>%
    filter(to %in% artist_songs, relation %in% collab_roles) %>%
    filter(from != artist_index) %>%
    as_tibble()
  
  collab_node_ids <- unique(c(artist_index, collab_edges$from, collab_edges$to))
  
  subgraph <- graph %>%
  as.igraph() %>%
  induced_subgraph(vids = collab_node_ids) %>%
  as_tbl_graph() %>%
  activate(edges) %>%
  filter(relation %in% collab_roles) %>%          
  activate(nodes) %>%
  mutate(label = case_when(
    `Node Type` == "Song" ~ paste0(name, " (", release_date, ")"),
    TRUE ~ name
  ))
  
  return(subgraph)
}

Public Recognition

Code 
public_recognition_table <- function(graph, artist_name) {
  artist_id <- graph %>%
    activate(nodes) %>%
    mutate(row_id = row_number()) %>%
    filter(name == artist_name) %>%
    pull(row_id)

  group_ids <- graph %>%
    activate(edges) %>%
    filter(from == artist_id, relation == "MemberOf") %>%
    pull(to)

  performer_ids <- if (length(group_ids) > 0) c(artist_id, group_ids) else artist_id

  performer_edges <- graph %>%
    activate(edges) %>%
    filter(from %in% performer_ids, relation == "PerformerOf") %>%
    as_tibble() %>%
    mutate(Performer = ifelse(from == artist_id, "Solo", "Group"))

  node_df <- graph %>%
    activate(nodes) %>%
    as_tibble() %>%
    mutate(row_id = row_number())

  charted <- performer_edges %>%
    left_join(node_df, by = c("to" = "row_id")) %>%
    filter(type %in% c("Song", "Album"), notable == TRUE) %>%
    filter(type != "Song" | single == TRUE) %>%
    transmute(
      Title = name,
      Type = type,
      Performer,
      `Release Year` = release_date
    )

  solo <- charted %>%
    filter(Performer == "Solo") %>%
    bind_rows(tibble(
      Title = "Total",
      Type = "",
      Performer = "",
      `Release Year` = as.character(nrow(.))
    ))

  group <- charted %>%
    filter(Performer == "Group") %>%
    bind_rows(tibble(
      Title = "Total",
      Type = "",
      Performer = "",
      `Release Year` = as.character(nrow(.))
    ))

  return(list(Solo = solo, Group = group))
}
Code 
public_recognition_line <- function(graph, artist_name = "Sailor Shift") {
  artist_id <- graph %>% 
    activate(nodes) %>% mutate(row_id = row_number()) %>% filter(name == artist_name) %>% pull(row_id)
  group_ids <- graph %>% activate(edges) %>% filter(from == artist_id, relation == "MemberOf") %>% pull(to)
  has_group <- length(group_ids) > 0
  performer_ids <- if (has_group) c(artist_id, group_ids) else artist_id

  performer_edges <- graph %>% activate(edges) %>%
    filter(from %in% performer_ids, relation == "PerformerOf") %>%
    as_tibble() %>%
    mutate(Performer = ifelse(from == artist_id, "Solo", "Group"))

  node_df <- graph %>% activate(nodes) %>% as_tibble() %>% mutate(row_id = row_number())

  charted_releases <- performer_edges %>%
    left_join(node_df, by = c("to" = "row_id")) %>%
    filter(type %in% c("Song", "Album"), notable == TRUE) %>%
    transmute(Title = name, Type = type, Performer, `Release Year` = as.integer(release_date), Single = single)

  albums <- charted_releases %>% filter(Type == "Album")
  singles <- charted_releases %>% filter(Type == "Song", Single == TRUE)

  album_counts <- albums %>% count(`Release Year`, Performer, name = "Count") %>% mutate(Type = "Album")
  single_counts <- singles %>% count(`Release Year`, Performer, name = "Count") %>% mutate(Type = "Song")

  all_years <- min(c(album_counts$`Release Year`, single_counts$`Release Year`), na.rm = TRUE):max(c(album_counts$`Release Year`, single_counts$`Release Year`), na.rm = TRUE)
  all_performers <- unique(charted_releases$Performer)

  album_complete <- album_counts %>% complete(`Release Year` = all_years, Performer = all_performers, Type = "Album", fill = list(Count = 0))
  single_complete <- single_counts %>% complete(`Release Year` = all_years, Performer = all_performers, Type = "Song", fill = list(Count = 0))

  song_dots <- expand.grid(`Release Year` = all_years, Performer = all_performers, stringsAsFactors = FALSE) %>%
    left_join(singles %>% count(`Release Year`, Performer, name = "Count"), by = c("Release Year", "Performer")) %>%
    mutate(Count = replace_na(Count, 0), Type = "Song")

  make_plot <- function(df, dots, performer_label, type_label) {
    line_color <- ifelse(type_label == "Song", cl$jeans, cl$jeans)
    dot_fill <- ifelse(performer_label == "Solo", cl$t_shirt, cl$t_shirt)

    ggplot(df, aes(x = `Release Year`, y = Count)) +
      geom_line(color = line_color, linewidth = 1, alpha = 0.5, linetype = "dashed") +
      geom_point(data = dots, aes(x = `Release Year`, y = Count), color = "black", fill = dot_fill, shape = 21, size = 2, inherit.aes = FALSE) +
      scale_y_continuous(limits = c(0, max(df$Count, na.rm = TRUE) + 1), expand = c(0, 0)) +
      scale_x_continuous(breaks = all_years) +
      labs(title = paste(performer_label, type_label), x = "Release Year", y = "Number of Releases") +
      theme_classic() +
      theme(
        plot.background = theme$background,
        panel.background = theme$panel,
        panel.grid.major = theme$grid,
        text = element_text(family = theme$font, size = theme$size),
        plot.title = theme$title,
        axis.text.x = element_text(angle = 90, vjust = 0.5, hjust = 1)
      )
  }

  p1 <- make_plot(album_complete %>% filter(Performer == "Solo"), album_complete %>% filter(Performer == "Solo"), "Solo", "Album")
  p2 <- make_plot(single_complete %>% filter(Performer == "Solo"), song_dots %>% filter(Performer == "Solo"), "Solo", "Song")
  p3 <- make_plot(album_complete %>% filter(Performer == "Group"), album_complete %>% filter(Performer == "Group"), "Group", "Album")
  p4 <- make_plot(single_complete %>% filter(Performer == "Group"), song_dots %>% filter(Performer == "Group"), "Group", "Song")

  if (has_group) {
  (p1 | p2) / (p3 | p4)
} else {
  p1 | p2
}
}

8.1.3 List of Oceanus Folk Artist

Code 
oceanus_nodes <- graph %>%
  activate(nodes) %>%
  mutate(row_id = row_number()) %>%
  filter(genre == "Oceanus Folk", `Node Type` %in% c("Song", "Album")) %>%
  pull(row_id)

oceanus_performers <- graph %>%
  activate(edges) %>%
  filter(to %in% oceanus_nodes, relation == "PerformerOf") %>%
  pull(from) %>%
  unique()

graph_with_centrality <- graph %>%
  activate(nodes) %>%
  mutate(
    degree_centrality = centrality_degree()
  )

centrality_table <- graph_with_centrality %>%
  activate(nodes) %>%
  mutate(row_id = row_number()) %>%
  filter(row_id %in% oceanus_performers, `Node Type` == "Person") %>%
  as_tibble() %>%
  select(name, `Node Type`, degree_centrality) %>%
  arrange(desc(degree_centrality))

colnames(centrality_table) <- c("Artist", "Node Type", "Connections")

centrality_table %>%
  kable(caption = "Artists Who Performed Oceanus Folk Songs or Albums")%>%
  scroll_box(height = "400px")
Artists Who Performed Oceanus Folk Songs or Albums
Artist Node Type Connections
Sailor Shift Person 52
Yang Wan Person 30
Rüdiger Graf Person 18
Filippo Pelli Person 18
Min Lei Person 16
Yong Dong Person 15
Xiuying Huang Person 15
Ping Zeng Person 14
Zacharie Martins Person 14
Beatrice Albright Person 14
Daniel O'Connell Person 14
Orla Seabloom Person 12
Guiying Liao Person 11
Theresa Rivera Person 11
Vanessa Ramos Person 11
Min Kong Person 10
Xia Jia Person 10
Guiying Cao Person 9
Na Lai Person 9
Chao Zeng Person 9
Xiuying Fang Person 9
Nicola Bernetti Person 9
Vincentio Gentili Person 9
Yong Wang Person 9
Tao Jin Person 9
Yan Zou Person 8
Lei Jin Person 8
Xiulan Yi Person 8
Martino Michelangeli Person 8
Isabella Farinelli Person 8
Xia Cui Person 8
Guglielmo Canetta Person 8
Juan Gong Person 8
Xia Zeng Person 8
Genevieve Bell Person 8
Jing Kang Person 7
Yong Shen Person 7
Yong Lai Person 7
Juan Yu Person 7
Monica Nelson Person 7
Yoko Fujita Person 7
Serena Lettiere Person 7
Xiulan Wang Person 7
Tao Yao Person 7
Charles Vazquez Person 7
Walter White Person 6
Jie Fan Person 6
Jie Cui Person 6
Tao Lei Person 6
Qiang Xie Person 6
Alfred Thibault Person 6
Xiuying Li Person 6
Wei Cheng Person 6
Yang Zhao Person 6
Jing Jin Person 6
Chao Zheng Person 6
Jörg Niemeier Person 6
Maya Jensen Person 6
Tao Cui Person 5
Ping Sun Person 5
Chao Tan Person 5
Na Peng Person 5
Wei Gao Person 5
Stephen Meyer Person 5
Yang Yao Person 5
Aneta Pruschke-Sölzer Person 5
Constance Guibert Person 5
Yan Yan Person 5
Zoé-Agnès Delaunay Person 5
Ping Peng Person 5
Lisa Hofmann Person 5
Yan Zhou Person 5
Xia Zhu Person 5
Ming Jia Person 5
Jie Su Person 5
Bryan Smith Person 5
Ronald Kennedy Person 5
Frédéric de la Coulon Person 5
Ming Xiao Person 5
Na Dai Person 5
Tao Dai Person 4
Jeffrey Watson Person 4
Qiang Song Person 4
Xia Xia Person 4
Min Jin Person 4
Ignazio Pastine Person 4
Fang Duan Person 4
Chao Xiao Person 4
Tao Lei Person 4
Tao Du Person 4
Christine Ward Person 4
Mikayla Cook Person 4
Na Wen Person 4
Ming Zhong Person 4
Valérie Mathieu Person 4
Xia Wu Person 4
Jing Zhang Person 4
Yan Luo Person 4
Michael Rivera Person 4
Fang Wu Person 4
Chad Marks Person 4
Thomas Ball Person 4
Kai Reynolds Person 4
Gang Shao Person 3
Xiulan Hao Person 3
Guiying Ding Person 3
Jun Wen Person 3
Nadia van Dooren-de Jode Vastraedsd Person 3
Coriolano Luria-Scialpi Person 3
Lisa Martin Person 3
Melissa Wheeler Person 3
Xiulan Ye Person 3
Xia Jia Person 3
Donna Caldwell Person 3
Min Gao Person 3
Ping Liao Person 3
Chao Sun Person 3
Madeleine Pineau Person 3
Laetitia Petitjean Person 3
Jun Shao Person 3
Wei Chang Person 3
Na Ma Person 3
Thibault Hardy Person 3
Ping Wu Person 3
Na Ren Person 3
Victoria Higgins Person 3
Donald Medina Person 3
Joshua Orozco Person 3
Qiang Qian Person 3
Jeffery Bailey Person 3
Lauretta Tresoldi Person 3
Kimberly Stanton Person 3
Jing Guo Person 3
Patricia Pope Person 3
Cesare Cicilia Person 3
Jie Yan Person 3
Adèle Bonneau Person 3
Jun Hao Person 3
Jun Han Person 3
Xiulan Zhang Person 3
Xiuying Mo Person 3
Yong Tao Person 3
Jun Xu Person 3
Yang Zhang Person 3
Yang Ma Person 3
Ping Xu Person 3
Xiulan Liang Person 3
Alphons Donati-Pederiva Person 3
Qiang Han Person 3
Min Mo Person 3
Jing Li Person 3
Jie Zhong Person 3
Jie Wang Person 3
Xia Du Person 3
Li Li Person 3
Ryan Adams Person 3
Min Huang Person 3
Xiulan Zhong Person 3
Jing Feng Person 3
Carlos Duffy Person 2
Min Qin Person 2
Justin Morse Person 2
Tara Kota Person 2
Xiuying Liang Person 2
Wei Liao Person 2
Xiulan Lin Person 2
Ming Yan Person 2
Donna Ryan Person 2
Xia Yan Person 2
Jing Ding Person 2
Juan Wen Person 2
Wei Guo Person 2
Xia Xiang Person 2
Jing Zhong Person 2
Juan Zeng Person 2
Chao Wu Person 2
Timothy Hansen Person 2
Lei Zeng Person 2
Na Ren Person 2
David Morgan Person 2
Mary Parsons Person 2
Susan Da Silva Person 2
Tao Ren Person 2
Guiying Xia Person 2
Yong Dai Person 2
Qiang He Person 2
Chao Tang Person 2
Yui Kondo Person 2
Qiang Song Person 2
Chao Lu Person 2
Ida Vigliotti Person 2
Tao Yin Person 2
Michael Snyder Person 2
Fang Gu Person 2
Tao Yao Person 2
Ping Cui Person 2
Tao Long Person 2
Yang Zhong Person 2
Jun Yu Person 2
Lei Kong Person 2
Yang Shao Person 2
Xiulan Hu Person 2
Michael Smith Person 2
Li Wen Person 2
Lei Tan Person 2
Tao Hu Person 2
Guiying Tao Person 2
Chao Wu Person 2
James Clark Person 2
Lei Qian Person 2
Courtney Phillips Person 2
Wei Ma Person 2
Gang Xiong Person 2
Qiang Luo Person 2
Min Song Person 2
Jun Yuan Person 2
Christine Jones Person 2
Morgan Hernandez Person 2
Ping Shao Person 2
Tao Qin Person 2
Xiulan Dong Person 2
Xiuying Zhang Person 2
Xiuying Deng Person 2
Jennifer Alexander Person 2
Latasha Watts Person 2
Jie Chang Person 2
Carly Luna Person 2
Justin Berry Person 2
Stephen Allen Person 2
Chao Qiao Person 2
Fang Xiang Person 2
Michael Anderson Person 2
Ricardo Ward Person 2
Fang Zhou Person 2
Xiulan Zhou Person 2
Juan Duan Person 2
Tao Qian Person 2
Chao Kang Person 2
Jun Ye Person 2
Tomoya Nakamura Person 2
Charles du Perez Person 2
Feliciano Pizarro Moll Person 2
Augusto Villaverde Armengol Person 2
Jun Zou Person 2
Jie Wan Person 2
Margaretha Sager Person 2
Guiying Pan Person 2
Xiuying Duan Person 2
Min Xia Person 2
Jie Wu Person 2
Isaiah Morales Person 2
Guiying Tang Person 2
Gang Shen Person 2
Renata Manolesso Person 2
Russell Bates Person 2
Gang Yang Person 2
Min Tian Person 2
Tao Xu Person 2
Jun Yi Person 2
Ping Meng Person 2
Guiying Zhong Person 2
Qiang Yang Person 2
Xia Zhao Person 2
Qiang Jiang Person 2
Tanya Garrett Person 2
John Maldonado Person 2
Michael Reyes Person 2
Summer Bender Person 2
Ann Holland Person 2
Guiying Qin Person 2
Lei Zheng Person 2
Xia Wang Person 2
Na Yi Person 2
Qiang Zhu Person 2
Paulo Oestrovsky Person 2
Amber Ramsey Person 2
Li Wan Person 2
Lagan Bhalla Person 2
Georgina Piñol-Guerra Person 2
Juan Dong Person 2
Jenna York Person 2
Yuki Hashimoto Person 2
Matthew Murphy Person 2
Douglas Roberts Person 2
Ming Zhou Person 2
Min Ding Person 2
Min Xiong Person 2
Tara Deshmukh Person 2
Yong Ding Person 2
Jie Long Person 2
Luce Loiseau Person 2
Ming Wang Person 2
Chao Zhou Person 2
Yesenia Miller Person 2
Xiuying Xie Person 1
Ryan Devan Person 1
Tiya Sani Person 1
Kimaya Srinivasan Person 1
Rhonda Brown Person 1
Mary Medina Person 1
Laura Gibbs Person 1
Raymond Mccoy Person 1
Brandy Reyes Person 1
Gang Pan Person 1
Chao Mo Person 1
Ping Feng Person 1
Li Deng Person 1
Lei Tao Person 1
Chao Wu Person 1
Min Xue Person 1
Min Yu Person 1
Jing Xu Person 1
Sonia Weeks Person 1
Richard Frazier Person 1
Gang Jiang Person 1
Juan Pan Person 1
Sandra Smith Person 1
Christopher Smith Person 1
Yong Chen Person 1
Gang Lai Person 1
Xiulan Lu Person 1
Min Jin Person 1
Wei Lai Person 1
Ming Wan Person 1
Qiang Lai Person 1
Yong Tan Person 1
Yan Tao Person 1
Li Zou Person 1
Gang Yin Person 1
Gang Zhang Person 1
Na Zou Person 1
Kaori Kobayashi Person 1
Juan Qiao Person 1
Jun Jin Person 1
Xiulan Ren Person 1
Guiying Yang Person 1
Ping Chang Person 1
Margherita Giammusso Person 1
Pina Garrone Person 1
Yang Mo Person 1
Ethan Sanchez Person 1
Yan Fang Person 1
Na Yang Person 1
Raymond Martin Person 1
Min Huang Person 1
Jing Xiang Person 1
Tao Zou Person 1
Li Qiao Person 1
Ping Tao Person 1
Na Han Person 1
Fang Zhong Person 1
Nicole Thomas Person 1
Gang Fan Person 1
Ming Qiao Person 1
Guiying Ye Person 1
Xiuying Huang Person 1
Jun Fu Person 1
Fang Han Person 1
Ming Su Person 1
Kelli Turner Person 1
Latasha Chavez Person 1
Patrizio Antonello-Salvemini Person 1
Na Qian Person 1
Eric Bartlett Person 1
Min Yan Person 1
Lei Tan Person 1
Min He Person 1
Li Qiu Person 1
Ping Yan Person 1
Xia Kang Person 1
Ming Yao Person 1
Xia Xia Person 1
Na Cai Person 1
Li Huang Person 1
Yong Ye Person 1
Ming Chen Person 1
Li Ding Person 1
Qiang Du Person 1
Deborah Norton Person 1
Li Long Person 1
Xiulan Xu Person 1
Gang Fu Person 1
Ming Du Person 1
Min Zheng Person 1
Jing Long Person 1
Xiuying Xiang Person 1
Lori Young Person 1
Sean Riggs Person 1
Gang Wang Person 1
Evelyn Gordon Person 1
Yan Hou Person 1
Jacob Arnold Person 1
Édouard-Rémy Clerc Person 1
Li Gu Person 1
Jie Cui Person 1
Gang Tian Person 1
Victoria Vazquez Person 1
Juan Wang Person 1
Jing Zhong Person 1
Juan Wu Person 1
Jessica Carney Person 1
Christopher Reilly Person 1
Monica Murphy Person 1
Jing Wei Person 1
Ann Anderson Person 1
Xiuying Kang Person 1
Karen Robinson Person 1
Li Zhou Person 1
Jun Wang Person 1
Fenna Zwart Person 1
Na Yang Person 1
Kimberly Moore Person 1
Xiulan Yi Person 1
Chao Fang Person 1
Tao Ye Person 1
Yong Guo Person 1
Jing Cui Person 1
Lisa Pennington Person 1
Xiuying Shao Person 1
Daria Ceravolo Person 1
Luciano Chindamo Person 1
Min Liao Person 1
Jie Bai Person 1
Yan Huang Person 1
Joseph Cole Person 1
Rachel Ford Person 1
Yang Qian Person 1
Juan Deng Person 1
Chiyo Suzuki Person 1
Kaori Watanabe Person 1
Jennifer Harris Person 1
Pauline Guyot de la Maillet Person 1
Adrien Weiss Person 1
Qiang Mo Person 1
Yan Wang Person 1
Regina Davis Person 1
Deborah Davis Person 1
Amanda Ramos Person 1
Leif Bien Person 1
Elsbeth Löwer Person 1
Alexej Klotz Person 1
Ping Zheng Person 1
Gang Meng Person 1
Lei Xue Person 1
Wei Qian Person 1
Nicholas Porter Person 1
Xiuying Jia Person 1
Christine Turner Person 1
Li Dai Person 1
Yong Tang Person 1
Tao Su Person 1
Jun Yuan Person 1
Xiulan Lai Person 1
Lei Su Person 1
Elena Nibali Person 1
Jose Garrett Person 1
David Nash Person 1
Amber Smith Person 1
Gang Zhu Person 1
Shlok Cherian Person 1
Xia Yu Person 1
Xiulan Xu Person 1
Xiulan Gu Person 1
Lei Liao Person 1
Jie Li Person 1
Mary King Person 1
Jie Xu Person 1
Yan Chang Person 1
Chao Cheng Person 1
Na Ren Person 1
Qiang Xie Person 1
Mitchell Bryan Person 1
Ming Qiu Person 1
Yang Lei Person 1
Fang Qiao Person 1
Ming Yu Person 1
Guiying Qiu Person 1
Jason Vaughn Person 1
Na Jin Person 1
Paul-Louis Benard Person 1
Yan Zhu Person 1
Chao Xiao Person 1
Ping Song Person 1
Xiulan Mo Person 1
Min Liang Person 1
Na Li Person 1
Xia Shao Person 1
Kyle Lawrence Person 1
Edward Little Person 1
Guiying Ma Person 1
Jonathan Morris Person 1
Xiuying Wei Person 1
Michael Jefferson Person 1
Andrew Lee Person 1
Michael Gregory Person 1
Maurice Harrison Person 1
Scott Burke Person 1
Devin Chan Person 1
Juan Gu Person 1
Qiang Dai Person 1
Xiulan He Person 1
Tao Chang Person 1
Mandy Hood Person 1
Robert Villanueva Person 1
Thomas Dudley Person 1
Charles Hall Person 1
James Mosley Person 1
Adriana Figueroa Person 1
Qiang Gao Person 1
Fang Yan Person 1
Jing Chang Person 1
Li Dong Person 1
Qiang Sun Person 1
Tomoya Takahashi Person 1
Taichi Sasaki Person 1
Na Deng Person 1
Xia Ye Person 1
Chelsea Harris Person 1
Chao Qiu Person 1
Emily Jackson Person 1
Jie Cheng Person 1
Juan Kang Person 1
Michaela Brooks Person 1
Rachel Rios Person 1
Tammie Johnson Person 1
Xia Shen Person 1
Gang Ding Person 1
Ming Deng Person 1
Wei Yao Person 1
Min Guo Person 1
Juan Xiang Person 1
Juan Cao Person 1
Yong Qiao Person 1
Christophe-Émile Grégoire Person 1
Georges Chrétien Person 1
Ming Xiang Person 1
Wei Chen Person 1
Yong Tang Person 1
Jie Xu Person 1
Steven Goodman Person 1
Lei Wan Person 1
Li Zeng Person 1
Guiying Dong Person 1
Na Peng Person 1
Na Jiang Person 1
Isla Quinn Person 1

8.1.4 Sailor Shift

Network Graph

Code 
result <- artist_creativity(graph,"Sailor Shift")
center <- c("Sailor Shift", result$group)
plot(
  result$graph,
  center_name = center,
  title = paste0(center[1], ": Songs and Release Years"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)

Line Graph

Code 
release_timeline(result$works,"Sailor Shift")

Network Graph

Code 
result <- contribution_network(graph,"Sailor Shift")
center <- c("Sailor Shift")
plot(
  result$graph,
  center_name = center,
  title = paste0("How many works ",center[1]," have contributed?"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)
Code 
result <- artist_collab_network(graph, "Sailor Shift")
center <- c("Sailor Shift")
plot(
  result,
  center_name = center,
  title = paste0(center[1], "'s Collaboration Network"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)
Code 
collaborator_count <- result %>%
  activate(nodes) %>%
  as_tibble() %>%
  filter(`Node Type` %in% c("Person", "MusicalGroup"), name != "Sailor Shift") %>%
  count(`Node Type`)

collaborator_count %>% 
  kable(caption = "Number of Collaborators")
Number of Collaborators
Node Type n
Person 40
MusicalGroup 8

Table

Code 
tables <- public_recognition_table(graph, "Sailor Shift")

tables$Solo %>%
  kable(caption = "Solo Charted Releases", align = "lccc")
Solo Charted Releases
Title Type Performer Release Year
Tidal Pop Waves Album Solo 2028
Salty Dreams Album Solo 2030
The Current & The Chord Album Solo 2032
Coral Beats Album Solo 2034
Tides & Ballads Album Solo 2036
Oceanbound Album Solo 2038
Echoes of the Deep Album Solo 2040
Stormsong Song Solo 2038
Tidesworn Ballads Album Solo 2031
Submerged Sonatas Album Solo 2031
Seashell Serenade Song Solo 2030
Total 11
Code 
tables$Group %>%
  kable(caption = "Group Charted Releases", align = "lccc")
Group Charted Releases
Title Type Performer Release Year
The Kelp Forest Canticles Album Group 2024
Luminescent Tides Album Group 2025
Shoreline Sonnets Album Group 2026
Salt-Kissed Rhymes Song Group 2026
Total 4

Line Graph

Code 
public_recognition_line(graph, "Sailor Shift")

8.1.5 Yang Wan

Network Graph

Code 
result <- artist_creativity(wan, "Yang Wan")
center <- c("Yang Wan", result$group)
plot(
  result$graph,
  center_name = center,
  title = paste0(center[1], ": Songs and Release Years"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)

Line Graph

Code 
release_timeline(result$works,"Yang Wan")

Network Graph

Code 
result <- contribution_network(wan,"Yang Wan")
center <- c("Yang Wan")
plot(
  result$graph,
  center_name = center,
  title = paste0("How many works ",center[1]," have contributed?"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)
Code 
result <- artist_collab_network(wan, "Yang Wan")
center <- c("Yang Wan")
plot(
  result,
  center_name = center,
  title = paste0(center[1], "'s Collaboration Network"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)
Code 
collaborator_count <- result %>%
  activate(nodes) %>%
  as_tibble() %>%
  filter(`Node Type` %in% c("Person", "MusicalGroup"), name != "Yang Wan") %>%
  count(`Node Type`)

collaborator_count %>% 
  kable(caption = "Number of Collaborators")
Number of Collaborators
Node Type n
Person 76
MusicalGroup 2

Table

Code 
tables <- public_recognition_table(wan, "Yang Wan")

tables$Solo %>%
  kable(caption = "Solo Charted Releases", align = "lccc")
Solo Charted Releases
Title Type Performer Release Year
Silent Projectiles Song Solo 2027
Echoes of Naomi Song Solo 2020
Bananal’s Gentle Whispers Song Solo 2020
Tender Embrace Song Solo 1994
Rakkauden Varjossa (In the Shadow of Love) Song Solo 2013
Perfect Harmony Song Solo 2003
Urban Haze Song Solo 2022
Whispers in the Unknown Song Solo 2026
Moments Between Heartbeats Song Solo 2023
Whispers Between Rooms Album Solo 2022
Scales and Streetlights Album Solo 2000
Canonical Refrain Song Solo 2015
Ringtone Requiem Song Solo 2013
Echoes of Armenia’s Crown Song Solo 2021
Silent Steps of Summer’s Daughter Album Solo 2001
Total 15
Code 
tables$Group %>%
  kable(caption = "Group Charted Releases", align = "lccc")
Group Charted Releases
Title Type Performer Release Year
Total 0

Line Graph

Code 
public_recognition_line(wan, "Yang Wan")

8.1.6 Rüdiger Graf

Network Graph

Code 
result <- artist_creativity(graf, "Rüdiger Graf")
center <- c("Rüdiger Graf", result$group)
plot(
  result$graph,
  center_name = center,
  title = paste0(center[1], ": Songs and Release Years"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)

Line Graph

Code 
release_timeline(result$works,"Rüdiger Graf")

Network Graph

Code 
result <- contribution_network(graf,"Rüdiger Graf")
center <- c("Rüdiger Graf")
plot(
  result$graph,
  center_name = center,
  title = paste0("How many works ",center[1]," have contributed?"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)
Code 
result <- artist_collab_network(graf, "Rüdiger Graf")
center <- c("Rüdiger Graf")
plot(
  result,
  center_name = center,
  title = paste0(center[1], "'s Collaboration Network"),
  size_1 = 5,
  size_2 = 8,
  show_arrows = TRUE,
  layout = "kk"
)
Code 
collaborator_count <- result %>%
  activate(nodes) %>%
  as_tibble() %>%
  filter(`Node Type` %in% c("Person", "MusicalGroup"), name != "Rüdiger Graf") %>%
  count(`Node Type`)

collaborator_count %>% 
  kable(caption = "Number of Collaborators")
Number of Collaborators
Node Type n
Person 25
MusicalGroup 1

Table

Code 
tables <- public_recognition_table(graf, "Rüdiger Graf")

tables$Solo %>%
  kable(caption = "Solo Charted Releases", align = "lccc")
Solo Charted Releases
Title Type Performer Release Year
Glasses Raised Song Solo 2027
Concrete Kingdom Song Solo 2026
Colorful Traditions Song Solo 2026
Artificial Intuition Node Song Solo 2024
Cosmic Cartography Song Solo 2026
Total 5
Code 
tables$Group %>%
  kable(caption = "Group Charted Releases", align = "lccc")
Group Charted Releases
Title Type Performer Release Year
Total 0

Line Graph

Code 
public_recognition_line(graf, "Rüdiger Graf")

Observations

  • Creative Activity : Sailor Shift built a long, steady career from 2024 to 2040, consistently releasing music, Yang Wan had an early start in 1994, disappeared for years, then made several strong comebacks after 2010, Rüdiger Graf rose quickly between 2024 and 2026, peaking fast but dropping off just as quickly a brief flash of fame that didn’t last. These distinct career patterns reveal that rising stars in Oceanus Folk begin with consistent growth.

  • Creative Contribution: Sailor Shift maintained a steady presence as a focused lyricist, Yang Wan contributed across multiple creative roles composer, lyricist, and producer showing strong versatility, Rüdiger Graf took on a mix of roles early on but lacked sustained involvement. This kind of observations suggest that rising stars often emerge through either consistent specialization on the rolse or early multi role engagement.

  • Collaboration: Yang Wan has the largest network with 76 individuals and 2 groups, showing broad influence and strong community presence, Sailor Shift has 40 individual and 8 group collaborators, suggesting a balanced, stable network built over time, while Rüdiger Graf has 25 individuals and 1 group—more limited, but notable given the shorter career span. Artists with high collaborator counts—especially early in their careers—tend to gain more exposure, expand their influence, and accelerate their growth. Thus, emerging artists who are quickly building networks are strong candidates to watch as the next rising stars.

  • Public Recognition: Sailor Shift stands out with both solo and group charted releases, showing broad reach and influence, Yang Wan has a strong solo-only chart record that reflects resilience and longevity, while Rüdiger Graf shows early momentum through recent solo chart activity, this is a key signal of rising star potential characteristics.

8.2 Question 3: The Next Rising Star of Oceanus Folk

Code 
nodes <- graph %>% 
  activate(nodes) %>% 
  mutate(row_id = row_number()) %>% 
  as_tibble()

edges <- graph %>% 
  activate(edges) %>% 
  as_tibble()

oceanus_nodes <- nodes %>%
  filter(genre == "Oceanus Folk", `Node Type` %in% c("Song", "Album")) %>%
  pull(row_id)

oceanus_performers <- edges %>%
  filter(to %in% oceanus_nodes, relation == "PerformerOf") %>%
  pull(from) %>% unique()

collabs <- edges %>%
  filter(relation %in% c("ComposerOf", "LyricistOf", "ProducerOf"),
         from %in% oceanus_performers) %>%
  group_by(from) %>%
  summarise(Collabs = n_distinct(to), Creative = n(), .groups = "drop")

release_info <- edges %>%
  filter(from %in% oceanus_performers, relation == "PerformerOf", to %in% oceanus_nodes) %>%
  left_join(nodes %>% select(row_id, release_date, notable), by = c("to" = "row_id")) %>%
  mutate(release_year = as.integer(release_date)) %>%
  filter(!is.na(release_year)) %>%
  left_join(nodes %>% select(row_id, name, `Node Type`) %>%
              rename(artist_id = row_id, artist_name = name),
            by = c("from" = "artist_id")) %>%
  filter(`Node Type` %in% c("Person", "MusicalGroup"))

current_year <- 2040

table <- release_info %>%
  group_by(artist_name, from) %>%
  summarise(
    First = min(release_year, na.rm = TRUE),
    Total = n(),
    Active = n_distinct(release_year),
    Charted = sum(notable == TRUE, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  filter(First >= 2030, Total >= 3) %>%
  left_join(collabs, by = "from") %>%
  mutate(
    Inactivity = (current_year - First + 1) - Active,
    Collabs = replace_na(Collabs, 0),
    Creative = replace_na(Creative, 0),
    Freshness = exp(-Inactivity * 0.4),
    ChartedRatio = Charted / Total,
    Score = round(((Total * 1.0) + (ChartedRatio * 15) + (Collabs * 1.0) + (Creative * 1.2)) * Freshness, 2)
  ) %>%
  arrange(desc(Score))

kable(table, col.names = c("Artist", "ID", "First Release", "Total Works", "Active Years",
                           "Charted", "Collabs", "Creative", "Inactivity", "Freshness",
                           "Charted Ratio", "Rising Star Score"))
Artist ID First Release Total Works Active Years Charted Collabs Creative Inactivity Freshness Charted Ratio Rising Star Score
The Brine Choir 17047 2034 7 3 4 1 1 4 0.2018965 0.5714286 3.59
Selkie’s Hollow 17121 2037 5 1 2 0 0 3 0.3011942 0.4000000 3.31
Copper Canyon Ghosts 17362 2034 7 2 7 0 0 5 0.1353353 1.0000000 2.98
Beatrice Albright 17350 2031 8 3 8 3 3 7 0.0608101 1.0000000 1.80
Daniel O’Connell 17356 2031 8 3 8 3 3 7 0.0608101 1.0000000 1.80
Tidal Reverie 16988 2033 5 2 2 0 0 6 0.0907180 0.4000000 1.00
Conclusions

Based on the computed metrics including total works, charted ratio, collaboration count, creative contributions, and a freshness score that penalizes inactivity the predicted rising stars in the Oceanus Folk genre are The Brine Choir, Selkie’s Hollow, and Copper Canyon.

Note

What Makes a Rising Star:

The model goes beyond just popularity. It also looks at:

  • Creative Activity: Regular releases, like Sailor Shift’s, suggest steady growth.
  • Creative Contribution: Versatile creators like Yang Wan, or focused ones like Sailor Shift, both show strong artistic identity.
  • Collaboration: Large, active networks—especially built early—are often signs of rising stars.
  • Public Recognition: Charted songs help, but they aren’t everything. Sailor Shift, for example, may not have a perfect chart ratio, but her consistency and connections still make her stand out.

Rising Star Score :

The score combines multiple aspects of an artist’s career to highlight those with strong future potential.

  • Total Works reflects how productive an artist has been.
  • Charted Ratio emphasizes public recognition impact matters more than volume.
  • Collaboration Count and Creative Contributions show how engaged and versatile an artist is behind the scenes.
  • All of these are adjusted by Freshness, which penalizes long inactivity artists who started early but went quiet get lower scores.

Additional Notes:

  • The current year is assumed to be 2040.
  • We filter artists whose works have release years between 2030 and 2040, and only artists with at least 3 releases during this period are included.This filtering helps exclude inactive or minimally active artists.

9 References

VAST Challenge Kickstarter 2